 ;;########################################################################
;; misdsd1.lsp
;; Copyright (c) 1998 by Pedro Valero (valerop@uv.es)
;; Code for Missing Data Analysis and Imputation. 
;;Computes descriptive statistics, correlations and so for missing data
;;
;;########################################################################

 
 (defmeth missing-data-model-object-proto :descmissing (listwisedatamatrix n data imputed-data-normal imputed-data-random variables missing-by-var)
   "Computes descriptive statistics. This function is designed by internal use and called by the analysis method of the missing-data-object-proto"
    (let (
          (variables variables)
          (uniwisedata nil)
          (listwisedata nil)
          (mediauniw nil)
          (medianauniw nil)
          (nuniw nil)
          (medialist nil)
          (medianalist nil)
          (nlist nil)
          (listwisedatamatrix listwisedatamatrix)
          (casos nil)
          (stdvlistwise nil)
          (stduniwise nil)
          (minlistwise nil)
          (minuniwise nil)
          (maxuniwise nil)
          (maxlistwise nil)
          (skewuniwise nil)
          (skewlistwise nil)
          (kurtosisuniwise nil)
          (kurtosislistwise nil)
          (casos n)
          (data data)
          (imputed-data-normal imputed-data-normal)
         
          (media-idn nil)
          (mediana-idn nil)
          (n-idn nil)
          (stdv-idn nil)
          (min-idn nil)
          (max-idn nil)
          (skew-idn nil)
          (kurtosis-idn nil)

          (imputed-data-random imputed-data-random)
          (media-idr nil)
          (mediana-idr nil)
          (n-idr nil)
          (stdv-idr nil)
          (min-idr nil)
          (max-idr nil)
          (skew-idr nil)
          (kurtosis-idr nil)
          (cases-missing (length (combine (non-missing missing-by-var))))
          (matrix-size (* n (length variables)))
          (mcar (send self :mcar-means-test))

          )
    
      (setf w (report-header 
                               (strcat (send self :title) " - Descriptives for missing data")
                               :page t))
      
      (display-string 
      	(format nil "~%~20a  " "DESCRIPTIVES FOR MISSING AND IMPUTED DATA") w)
      (display-string (format nil "~%~20a  " "") w)
      (display-string  
       (format nil  "~%~35a ~9,2f" "Number of cases" casos) w)
      (display-string    
       (format nil  "~%~35a ~9,2f" "Number of values in the data matrix" matrix-size) w)
      (display-string    
       (format nil "~%~35a ~9,2f" "Number of values missing" cases-missing) w)
      (display-string    
       (format nil "~%~35a ~9,2f" "Percentage of values missing" 
               (* 100 (/ cases-missing matrix-size))) w)
      ;;aqui Little's test

      (display-string    
       (format nil "~%~%~35a" "Little's MCAR means test" 
              ) w)
      (display-string    
       (format nil "~%~8,2a ~8,2a ~8,2a"  
               "Chisq" "df" "Prob") w)
      (display-string    
       (format nil "~%~1,2f ~8,2f ~8,2f "  
               (first mcar) (second mcar) (third mcar)) w)

      (display-string    
       (format nil "~%~20a ~%~20a ~%~20a ~%"  
               "If the probability is low we reject" 
               "that data are Missing " 
               "Completely At Random (MCAR)") w)


      (display-string    
       (format nil  "~%~16a ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~9,2f" "Descriptives" "Mean" "Median" "Std" "Skew" "Kurt" "Min" "Max" "Missing" "N") w )

   (dotimes (i (array-dimension data 1))

            ;Aqui lo relacionado con uniwise
            (setf uniwisedata (non-missing 
                         (col 
                          data
                          i)))
            (setf mediauniw (mean uniwisedata));media normal
            (setf medianuniw (median uniwisedata))
            (setf nuniw (length uniwisedata))
            (setf stduniwise (standard-deviation uniwisedata))
            (setf minuniwise (min uniwisedata))
            (setf maxuniwise (max uniwisedata))
            (setf skewuniwise (skewness uniwisedata))
            (setf kurtosisuniwise (kurtosis uniwisedata))

            ;Comienza lo relacionado con listwise
            (when (> (array-dimension listwisedatamatrix 0) 0)
                  (setf listwisedata (col listwisedatamatrix i))
                  (setf medialist (mean listwisedata))
                  (setf medianalist (median listwisedata))
                  (setf nlist (length listwisedata))
                  (setf stdlistwise (standard-deviation listwisedata))
                  (setf minlistwise (min listwisedata))
                  (setf maxlistwise (max listwisedata))
                  (setf skewlistwise (skewness listwisedata))
                  (setf kurtosislistwise (kurtosis listwisedata)))
            (when (= (array-dimension listwisedatamatrix 0) 0)
                  (setf medialist nil)
                  (setf medianalist nil)
                  (setf nlist 0)
                  (setf stdlistwise nil)
                  (setf minlistwise nil)
                  (setf maxlistwise nil)
                  (setf skewlistwise nil)
                  (setf kurtosislistwise nil))
            ;aqui empieza lo de la impresion

            ; aqui lo relacionado con imputed-data-normal

            
            ;(setf media-idn (mean (col imputed-data-normal i)))
            (setf media-idn (select (send self :em-means) i))
            (setf mediana-idn (median (col imputed-data-normal i)))
            (setf n-idn (length (col imputed-data-normal i)))
            (setf std-idn (standard-deviation (col imputed-data-normal i)))
            (setf std-idn (sqrt (aref (send self :emcovariance) i i)))
            (setf min-idn (min (col imputed-data-normal i)))
            (setf max-idn (max (col imputed-data-normal i)))
            (setf skew-idn (skewness (col imputed-data-normal i)))
            (setf kurtosis-idn (kurtosis (col imputed-data-normal i)))

 ; aqui lo relacionado con imputed-data-normal

            (setf media-idr (mean (col imputed-data-random i)))
            (setf mediana-idr (median (col imputed-data-random i)))
            (setf n-idr (length (col imputed-data-random i)))
            (setf std-idr (standard-deviation (col imputed-data-random i)))
            (setf min-idr (min (col imputed-data-random i)))
            (setf max-idr (max (col imputed-data-random i)))
            (setf skew-idr (skewness (col imputed-data-random i)))
            (setf kurtosis-idr (kurtosis (col imputed-data-random i)))




            (display-string  
                      (format nil "~%~20a" (select variables i)) w)
            (display-string   
             (format nil "~%~0a ~12a ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f"
                     "" "Uniwise" mediauniw medianuniw  
                     stduniwise skewuniwise kurtosisuniwise minuniwise 
                     maxuniwise (- casos nuniw) nuniw)w )          
            (display-string  
             (format nil "~%~0a ~12a ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f" 
                             "" "Listwise" medialist medianalist stdlistwise 
                             skewlistwise kurtosislistwise minlistwise  
                             maxlistwise (- casos nlist) nlist) w)

            (display-string  
             (format nil "~%~0a ~12a ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f" 
                             "" "EM     " media-idn mediana-idn std-idn 
                             skew-idn kurtosis-idn min-idn  
                             max-idn 0 0) w)

             (display-string  
             (format nil "~%~0a ~12a ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f" 
                            ""  "Imp-rand" media-idr mediana-idr std-idr 
                             skew-idr kurtosis-idr min-idr  
                             max-idr 0 0) w)
            )
      (send w :fit-window-to-text)
      ))

(defmeth  missing-data-model-object-proto  
  :repcomparecorr 
  (listwisecorrelations pairwisecorrelations npairwise n1 n2 
                        emcorrelations nlistwise ntotal)
   "Prints correlations. This function is designed by internal use and called by the analysis method of the missing-data-object-proto"
  (let* (
         (corrlistwise nil)         
         (emcorrelations emcorrelations)
         (corrpairwise pairwisecorrelations)
         (NPairwise npairwise)
         (N1 n1)
         (n2 n2)
         (NListwise nlistwise)
         (corrlistwise listwisecorrelations)
         (ntotal ntotal)
         (correlations-missing (corrmissing (send self :data-matrix-missing)))
         (listvariables (first (send self :listvariables))) ;no queria hacerlo asi 
         ;pero parece ser la unica manera de hacerlo funcionar
         

         )
    (setf w (report-header 
                               (strcat (send self :title) " - Correlations for missing data")
                               :page t))
    
    (display-string
    	(format nil "~%~20a  " "COMPARISONS BETWEEN CORRELATIONS USING DIFFERENT METHODS") w)
    (display-string (format nil "~%~20a  " "") w)
    (display-string 
     (format nil "~%~20a ~5,2f" "Ntotal" ntotal) w)
	
    (display-string 
     (format nil "~%~20a ~5,2f" "NListwise" NListwise) w)
   
    (display-string  
     (format nil "~%~24a ~8a ~8a ~7a ~8a ~8a  ~6a ~6a" "Variables" "EM  " "Pair" "List" "N PW" "N V1" "N V2" "CorrMissing" ) 
      w)
    (dotimes (i (length listvariables))
         (display-string 
          (format nil "~%~20a ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f ~8,2f" 
                  (select listvariables i) 
                  (select emcorrelations i)
                  (if (= (select corrpairwise i) 0) nil (select corrpairwise i))
                  (if (= (select corrlistwise i) 0) nil (select corrlistwise i))                      
                  (select Npairwise i) 
                  (select n1 i)
                  (select n2 i)
                  (select correlations-missing i)
                                   
                  
                  ) w)
             )    
    (send w :fit-window-to-text)
    ))

(defun corrmissing (missingness-matrix)
  "ARGS: A matrix of ones and zeros. Computes correlations and returns the lowest triangle as a list. Controls for variables with no variance and prints NIL."
  (let* (
;<<<<<<< MISSD1.LSP
         (var-with-variance (which (mapcar 'variancep (column-list missingness-matrix))))
         (numvars (array-dimension missingness-matrix 1))
         (numcases (array-dimension missingness-matrix 0))
         (matrix-out (make-array (list numvars numvars) :initial-element 'nil))
         )
    (setf (select matrix-out var-with-variance var-with-variance)
          (correlation-matrix (select missingness-matrix (iseq numcases) var-with-variance))
          )
    (matrix-to-list matrix-out)))

#|
=======
        (missingness-matrix missingness-matrix)
        (casos (array-dimension missingness-matrix 0))
         (numvariables (array-dimension missingness-matrix 1))
         (corrmissinglist nil)
        )
    (dotimes (i numvariables)
             (dotimes (j i)
                     	(if
                        (and
                          (variancep 
                           (col missingness-matrix i))
                          (variancep 
                           (col missingness-matrix j)))
                         (push (aref 
                                (correlation-matrix 
                                 (bind-columns (col missingness-matrix j)
                                               (col missingness-matrix i)))
                                0 1)
                               corrmissinglist)
                       (push 'nil corrmissinglist))))
                          
 (reverse corrmissinglist))
    )
>>>>>>> 1.2
|#

(defmeth missing-data-model-object-proto :descriptives-by-pattern (data)

  (let* 
    (
     
     (data data)
     
    
     (patterns (patterns-missing data)) ;esta llamada es excesiva deberia calcularse fuera de la funcion asi como otras que hay por ahí
     (cases-in-patterns (cases-in-missing-patterns data))  ;aqui hay otra cosa que deberia venir de fuera
     (rows-in-patterns (select cases-in-patterns 0))
     (n-patterns (select cases-in-patterns 1))
     (rows-pattern-s nil)
     (data-pattern-s nil)
     (n-s nil)
     (mean-s nil)
     (standard-deviation-s nil)
     (tempprint nil)
     (num-variables (length (column-list data)))
     (matrixprint (make-array (list (* (length n-patterns) 3) (+ 1 num-variables))))
     )
                       


    (dotimes (s (length n-patterns))
    
             
             (setf data-pattern-s (select data (select rows-in-patterns s)
                               (observed-in-missing-pattern patterns s)))
             ; (setf (select matrixprint s 0) (coerce (select patterns s) 'list ))
             ;la de arriba no funciona 
             (setf (select matrixprint s (+ 1 (observed-in-missing-pattern patterns s))) 
                   (array-dimension data-pattern-s 0))   
             (setf mean-s (mapcar 'mean (column-list data-pattern-s)))
             (setf standard-deviation-s 
                   (mapcar 'standard-deviation (column-list data-pattern-s)))
            
             ;aqui se puede añadir todos aquellos descriptivos que parezcan convenientes

             (setf tempprint (list (select patterns s) n-s mean-s standard-deviation-s))
             
             )
    (print-matrix matrixprint)
    )
  )




;<<<<<<< MISSD1.LSP
(defmeth missing-data-model-object-proto :MCAR-means-test ()
     (let* (
            (data (send self :data))
            (em-means (send self :em-means))
            (em-covars (send self :emcovariance))
            ;(missing-patterns 
             ;(cases-in-missing-patterns2 data))
            (N (array-dimension data 0))
            (nvars (array-dimension data 1))
            (ci (/ (mapcar 'length (send self :cases-by-missing-pattern)) N))
            (observed-by-pattern
             (mapcar #'(lambda (miss-pattern) 
                         (which (map-elements #'equalp 1 (coerce miss-pattern 'list))))
             (send self :patterns-missing)))
            (means-observed-by-pattern
                         (mapcar #'(lambda (cases-in-pattern vars-in-pattern) 
                                    (mapcar #'(lambda (var)
                                                (mean var))
                                                (column-list 
                                                 (select data
                                                         cases-in-pattern 
                                                         vars-in-pattern 
                                                         )))
                                     )
                                 
                                  (send self :cases-by-missing-pattern) observed-by-pattern))
            (number-of-means (length (combine means-observed-by-pattern)))
            (means-imputed-by-pattern
             (mapcar #'(lambda (vars-in-pattern) 
                         (select em-means vars-in-pattern))
                     observed-by-pattern))
            (covars-imputed-by-pattern            
             (mapcar #'(lambda (vars-in-pattern) 
                         (select em-covars vars-in-pattern vars-in-pattern))
                     observed-by-pattern))
            (d (* (sum (mapcar #'(lambda 
                           (prop means-obs means-imput covar-imput)           
                           (matmult prop (- means-obs means-imput) 
                              (inverse covar-imput)
                              (- means-obs means-imput)))
                           ci 
                           means-observed-by-pattern
                           means-imputed-by-pattern
                           covars-imputed-by-pattern)) N))
            (dgfreed (- number-of-means nvars))

            )
       (list d dgfreed (- 1 (chisq-cdf d dgfreed )))
             ))

 (defun cases-in-missing-patterns2 (data)
  "Args: (DATA) Outputs cases in each of the patterns of missing data obtained with the function patterns-missing"
 (let* (
        (data data)
        (patterns (reverse (patterns-missing data)))
        (number-of-patterns (length patterns))
        (matrix-missing (data-matrix-missing data))
        (n (length (row-list matrix-missing)))
        (cases-with-patterns nil)
        )
   (dotimes (i number-of-patterns)
            (setf cases-with-patterns 
                  (append cases-with-patterns 
                          (list (which 
                                 (mapcar #'equalp 
                                         (row-list matrix-missing) 
                                         (repeat (list (select patterns i))
                                                 n))))
                          ))
            )
   (list cases-with-patterns (mapcar #'length cases-with-patterns) patterns matrix-missing)))

;=======
(defmeth missing-data-model-object-proto :MCAR-means-test ()
     (let* (
            (data (send self :data))
            (em-means (send self :em-means))
            (em-covars (send self :emcovariance))
            (missing-patterns 
             (cases-in-missing-patterns2 data))
            (N (array-dimension data 0))
            (nvars (array-dimension data 1))
            (ci (/ (second missing-patterns) N))
            (observed-by-pattern
             (mapcar #'(lambda (miss-pattern) 
                         (which (map-elements #'equalp 1 (coerce miss-pattern 'list))))
             (third missing-patterns)))
            (means-observed-by-pattern
                         (mapcar #'(lambda (cases-in-pattern vars-in-pattern) 
                                    (mapcar #'(lambda (var)
                                                (mean var))
                                                (column-list 
                                                 (select data
                                                         cases-in-pattern 
                                                         vars-in-pattern 
                                                         )))
                                     )
                                 
                                  (first missing-patterns) observed-by-pattern))
            (number-of-means (length (combine means-observed-by-pattern)))
            (means-imputed-by-pattern
             (mapcar #'(lambda (vars-in-pattern) 
                         (select em-means vars-in-pattern))
                     observed-by-pattern))
            (covars-imputed-by-pattern            
             (mapcar #'(lambda (vars-in-pattern) 
                         (select em-covars vars-in-pattern vars-in-pattern))
                     observed-by-pattern))
            (d (* (sum (mapcar #'(lambda 
                           (prop means-obs means-imput covar-imput)           
                           (matmult prop (- means-obs means-imput) 
                              (inverse covar-imput)
                              (- means-obs means-imput)))
                           ci 
                           means-observed-by-pattern
                           means-imputed-by-pattern
                           covars-imputed-by-pattern)) N))
            (dgfreed (- number-of-means nvars))

            )
       (list d dgfreed (- 1 (chisq-cdf d dgfreed )))
             ))

 (defun cases-in-missing-patterns2 (data)
  "Args: (DATA) Outputs cases in each of the patterns of missing data obtained with the function patterns-missing"
 (let* (
        (data data)
        (patterns (reverse (patterns-missing data)))
        (number-of-patterns (length patterns))
        (matrix-missing (data-matrix-missing data))
        (n (length (row-list matrix-missing)))
        (cases-with-patterns nil)
        )
   (dotimes (i number-of-patterns)
            (setf cases-with-patterns 
                  (append cases-with-patterns 
                          (list (which 
                                 (mapcar #'equalp 
                                         (row-list matrix-missing) 
                                         (repeat (list (select patterns i))
                                                 n))))
                          ))
            )
   (list cases-with-patterns (mapcar #'length cases-with-patterns) patterns matrix-missing)));>>>>>>> 1.2
